<link href="http://feeds.unknownlamer.org/rss/site-updates"
rel="alternate" type="application/rss+xml" title="Updates Feed" />
-<link rel="stylesheet" href="default.css" media="screen" />
+<link rel="stylesheet" href="default.css" />
</head>
<body>
<h1>Metaobject Protocols</h1>
</dl>
</dd>
<dt>
-<a href="#sec25">Procedural Only Where Neccesary</a>
+<a href="#sec25">Procedural Only Where Necessary</a>
</dt>
<dt>
<a href="#sec26">Real World</a>
</dl>
</dd>
<dt>
-<a href="#sec30">Sources &amp; Further Reading</a>
+<a href="#sec30">Sources and Further Reading</a>
</dt>
<dd>
<dl>
</dt>
</dl>
</dd>
+<dt>
+<a href="#sec39">Software</a>
+</dt>
+<dd>
+<dl>
+<dt>
+<a href="#sec40">Closer to MOP</a>
+</dt>
+</dl>
+</dd>
</dl>
</dd>
</dl>
<p>Classes are defined with <code>defclass</code></p>
<pre class="src">
-(<span style="color: #b9d3ee;">defclass</span> <span style="color: #98fb98;">name</span> (superclasses ...)
- ((slot-name <span style="color: #b0c4de;">:accessor</span> slot-accessor ...)
+(<span class="emacs-face-keyword">defclass</span> <span class="emacs-face-type">name</span> (superclasses ...)
+ ((slot-name <span class="emacs-face-builtin">:accessor</span> slot-accessor ...)
...)
(class-options ...))
-(<span style="color: #b9d3ee;">defclass</span> <span style="color: #98fb98;">example</span> ()
- ((foo <span style="color: #b0c4de;">:accessor</span> foo-of <span style="color: #b0c4de;">:initform</span> 5)))
+(<span class="emacs-face-keyword">defclass</span> <span class="emacs-face-type">example</span> ()
+ ((foo <span class="emacs-face-builtin">:accessor</span> foo-of <span class="emacs-face-builtin">:initform</span> 5)))
-(<span style="color: #b9d3ee;">defclass</span> <span style="color: #98fb98;">example-child</span> (example)
- ((bar <span style="color: #b0c4de;">:accessor</span> bar-of <span style="color: #b0c4de;">:initform</span> (list 1 2 3))))
+(<span class="emacs-face-keyword">defclass</span> <span class="emacs-face-type">example-child</span> (example)
+ ((bar <span class="emacs-face-builtin">:accessor</span> bar-of <span class="emacs-face-builtin">:initform</span> (list 1 2 3))))
</pre>
-<p>Slot defintions have several options; the above example shows only the
+<p>Slot definitions have several options; the above example shows only the
<code>:accessor</code> and <code>:initform</code> options which are the most commonly
used. <code>:accessor</code> generates an accessor for the slot (e.g. if you have
an instance of <code>example</code> you can <code>(setf (foo-of some-example-instance)
enable selective modification of individual facets with minimal code.</p>
<pre class="src">
-(<span style="color: #b9d3ee;">defgeneric</span> <span style="color: #87cefa;">generic</span> (parameters ...)
+(<span class="emacs-face-keyword">defgeneric</span> <span class="emacs-face-function-name">generic</span> (parameters ...)
(options) ...)
-(<span style="color: #b9d3ee;">defmethod</span> <span style="color: #87cefa;">generic-name</span> ((parameter type) parameter ...)
- <span style="color: #b3b3b3;">"documentation string"</span>
+(<span class="emacs-face-keyword">defmethod</span> <span class="emacs-face-function-name">generic-name</span> ((parameter type) parameter ...)
+ <span class="emacs-face-doc">"documentation string"</span>
body)
-(<span style="color: #b9d3ee;">defgeneric</span> <span style="color: #87cefa;">foo</span> (bar baz quux)
- (<span style="color: #b0c4de;">:documentation</span> <span style="color: #b3b3b3;">"Process the baz with the quux capacitor to make the
+(<span class="emacs-face-keyword">defgeneric</span> <span class="emacs-face-function-name">foo</span> (bar baz quux)
+ (<span class="emacs-face-builtin">:documentation</span> <span class="emacs-face-doc">"Process the baz with the quux capacitor to make the
foo widget fly into the sky at warp speed"</span>))
-(<span style="color: #b9d3ee;">defmethod</span> <span style="color: #87cefa;">foo</span> ((bar example) baz (quux capacitor))
+(<span class="emacs-face-keyword">defmethod</span> <span class="emacs-face-function-name">foo</span> ((bar example) baz (quux capacitor))
(launch bar (process-with quux baz)))
</pre>
programs. Many of them are merely methods to get around deficiencies
in the language, and can be quite messy to implement in some
languages. Ideally a pattern would be subsumed by the language, but
-real world contraints require language standards to remain fairly
+real world constraints require language standards to remain fairly
static.</p>
<h5>Example: Object Inspector</h5>
<pre class="src">
-(<span style="color: #b9d3ee;">defgeneric</span> <span style="color: #87cefa;">example-inspect</span> (instance)
- (<span style="color: #b0c4de;">:documentation</span> <span style="color: #b3b3b3;">"Simple object inspector using CLOS MOP"</span>))
+(<span class="emacs-face-keyword">defgeneric</span> <span class="emacs-face-function-name">example-inspect</span> (instance)
+ (<span class="emacs-face-builtin">:documentation</span> <span class="emacs-face-doc">"Simple object inspector using CLOS MOP"</span>))
-(<span style="color: #b9d3ee;">defmethod</span> <span style="color: #87cefa;">example-inspect</span> ((instance t))
- (format t <span style="color: #b3b3b3;">"Simple Object~% Value: ~S~%"</span> instance))
+(<span class="emacs-face-keyword">defmethod</span> <span class="emacs-face-function-name">example-inspect</span> ((instance t))
+ (format t <span class="emacs-face-string">"Simple Object~% Value: ~S~%"</span> instance))
-(<span style="color: #b9d3ee;">defmethod</span> <span style="color: #87cefa;">example-inspect</span> ((instance standard-object))
- (<span style="color: #b9d3ee;">let</span> ((class (class-of instance)))
- (format t <span style="color: #b3b3b3;">"Class: ~S, Superclasses: ~S~%"</span>
+(<span class="emacs-face-keyword">defmethod</span> <span class="emacs-face-function-name">example-inspect</span> ((instance standard-object))
+ (<span class="emacs-face-keyword">let</span> ((class (class-of instance)))
+ (format t <span class="emacs-face-string">"Class: ~S, Superclasses: ~S~%"</span>
(class-name class)
(mapcar #'class-name
(class-precedence-list class)))
- (<span style="color: #b9d3ee;">let</span> ((slot-names (mapcar #'slot-definition-name
+ (<span class="emacs-face-keyword">let</span> ((slot-names (mapcar #'slot-definition-name
(class-slots class))))
- (format t <span style="color: #b3b3b3;">"Slots: ~%~{ ~S~%~}"</span> slot-names)
+ (format t <span class="emacs-face-string">"Slots: ~%~{ ~S~%~}"</span> slot-names)
(inspect-loop slot-names instance #'example-inspect))))
-(<span style="color: #b9d3ee;">defun</span> <span style="color: #87cefa;">inspect-loop</span> (slots instance inspector)
- (format t <span style="color: #b3b3b3;">"Enter slot to inspect or :pop to go up one level: "</span>)
+(<span class="emacs-face-keyword">defun</span> <span class="emacs-face-function-name">inspect-loop</span> (slots instance inspector)
+ (format t <span class="emacs-face-string">"Enter slot to inspect or :pop to go up one level: "</span>)
(finish-output)
- (<span style="color: #b9d3ee;">let*</span> ((slot (read))
+ (<span class="emacs-face-keyword">let*</span> ((slot (read))
(found-slot (member slot slots)))
- (<span style="color: #b9d3ee;">cond</span> (found-slot
+ (<span class="emacs-face-keyword">cond</span> (found-slot
(funcall inspector (slot-value instance slot))
(funcall inspector instance))
- ((eq slot <span style="color: #b0c4de;">:pop</span>) t)
+ ((eq slot <span class="emacs-face-builtin">:pop</span>) t)
(t
- (format t <span style="color: #b3b3b3;">"~S is invalid. Valid slot names: ~S~%"</span>
+ (format t <span class="emacs-face-string">"~S is invalid. Valid slot names: ~S~%"</span>
slot
slots)
(inspect-loop slots instance inspector)))))
implementing methods which override certain aspects of the language
behavior. This class of MOPs are what make MOPs especially
powerful. No longer must a problem be restructured to fit the
-implementation language; the underyling language can be reshaped to
+implementation language; the underlying language can be reshaped to
fit the task at hand, and obfuscation of the intended structure of the
application can be avoided.</p>
<p>In a language lacking a MOP, implementing the observer pattern
requires modifying every accessor of a class to explicitly invoke any
-observers, and neccesitates the addition of a mixin class to the class
-heirarchy. The fact that an object can be observed is a meta property
+observers, and necessitates the addition of a mixin class to the class
+hierarchy. The fact that an object can be observed is a meta property
of the class, and forcing it to be implemented at the application
-level dirties the inheritance heirarchy and adds uneccesary meta
+level dirties the inheritance hierarchy and adds unnecessary meta
details to the program.</p>
<pre class="src">
-<span style="color: #ff7f24;">;;; </span><span style="color: #ff7f24;">This metaclass adds a slot to instances which use it, and so the
-</span><span style="color: #ff7f24;">;;; </span><span style="color: #ff7f24;">system is defined in its own package to avoid name conflicts
-</span>(<span style="color: #b9d3ee;">defpackage</span> <span style="color: #98fb98;">:observer</span>
- (<span style="color: #b0c4de;">:use</span> <span style="color: #b0c4de;">:cl</span> #+sbcl <span style="color: #b0c4de;">:sb-mop</span>)
- (<span style="color: #b0c4de;">:export</span> observable register-observer unregister-observer))
+<span class="emacs-face-comment-delimiter">;;; </span><span class="emacs-face-comment">This metaclass adds a slot to instances which use it, and so the
+</span><span class="emacs-face-comment-delimiter">;;; </span><span class="emacs-face-comment">system is defined in its own package to avoid name conflicts
+</span>(<span class="emacs-face-keyword">defpackage</span> <span class="emacs-face-type">:observer</span>
+ (<span class="emacs-face-builtin">:use</span> <span class="emacs-face-builtin">:cl</span> <span class="emacs-face-builtin">:c2mop</span>)
+ (<span class="emacs-face-builtin">:export</span> observable register-observer unregister-observer))
-(<span style="color: #b9d3ee;">in-package</span> <span style="color: #b0c4de;">:observer</span>)
+(<span class="emacs-face-keyword">in-package</span> <span class="emacs-face-builtin">:observer</span>)
-<span style="color: #ff7f24;">;;; </span><span style="color: #ff7f24;">Metaclass
-</span>(<span style="color: #b9d3ee;">defclass</span> <span style="color: #98fb98;">observable</span> (standard-class)
+<span class="emacs-face-comment-delimiter">;;; </span><span class="emacs-face-comment">Metaclass
+</span>(<span class="emacs-face-keyword">defclass</span> <span class="emacs-face-type">observable</span> (standard-class)
()
- (<span style="color: #b0c4de;">:documentation</span> <span style="color: #b3b3b3;">"Metaclass for observable objects"</span>))
+ (<span class="emacs-face-builtin">:documentation</span> <span class="emacs-face-doc">"Metaclass for observable objects"</span>))
-(<span style="color: #b9d3ee;">defmethod</span> <span style="color: #87cefa;">compute-slots</span> ((class observable))
- <span style="color: #b3b3b3;">"Add a slot for storing observers to observable instances"</span>
+(<span class="emacs-face-keyword">defmethod</span> <span class="emacs-face-function-name">compute-slots</span> ((class observable))
+ <span class="emacs-face-doc">"Add a slot for storing observers to observable instances"</span>
(cons (make-instance 'standard-effective-slot-definition
- <span style="color: #b0c4de;">:name</span> 'observers
- <span style="color: #b0c4de;">:initform</span> '(make-hash-table)
- <span style="color: #b0c4de;">:initfunction</span> #'(<span style="color: #b9d3ee;">lambda</span> () (make-hash-table)))
+ <span class="emacs-face-builtin">:name</span> 'observers
+ <span class="emacs-face-builtin">:initform</span> '(make-hash-table)
+ <span class="emacs-face-builtin">:initfunction</span> #'(<span class="emacs-face-keyword">lambda</span> () (make-hash-table)))
(call-next-method)))
-(<span style="color: #b9d3ee;">defmethod</span> <span style="color: #87cefa;">validate-superclass</span> ((class observable)
+(<span class="emacs-face-keyword">defmethod</span> <span class="emacs-face-function-name">validate-superclass</span> ((class observable)
(super standard-class))
t)
-(<span style="color: #b9d3ee;">defun</span> <span style="color: #87cefa;">register-observer</span> (instance slot-name key closure)
+(<span class="emacs-face-keyword">defun</span> <span class="emacs-face-function-name">register-observer</span> (instance slot-name key closure)
(register-observer-with-class (class-of instance)
instance
slot-name
key
closure))
-(<span style="color: #b9d3ee;">defun</span> <span style="color: #87cefa;">unregister-observer</span> (instance slot-name key)
+(<span class="emacs-face-keyword">defun</span> <span class="emacs-face-function-name">unregister-observer</span> (instance slot-name key)
(unregister-observer-with-class (class-of instance)
instance
slot-name
key))
-(<span style="color: #b9d3ee;">defun</span> <span style="color: #87cefa;">get-observers</span> (instance slot-name)
+(<span class="emacs-face-keyword">defun</span> <span class="emacs-face-function-name">get-observers</span> (instance slot-name)
(get-observers-with-class (class-of instance)
instance
slot-name))
-(<span style="color: #b9d3ee;">defun</span> <span style="color: #87cefa;">add-observer-table</span> (instance slot-name)
+(<span class="emacs-face-keyword">defun</span> <span class="emacs-face-function-name">add-observer-table</span> (instance slot-name)
(setf (gethash slot-name (slot-value instance
'observers))
(make-hash-table)))
-(<span style="color: #b9d3ee;">defgeneric</span> <span style="color: #87cefa;">register-observer-with-class</span> (class instance slot-name key closure))
-(<span style="color: #b9d3ee;">defgeneric</span> <span style="color: #87cefa;">unregister-observer-with-class</span> (class
+(<span class="emacs-face-keyword">defgeneric</span> <span class="emacs-face-function-name">register-observer-with-class</span> (class instance slot-name key closure))
+(<span class="emacs-face-keyword">defgeneric</span> <span class="emacs-face-function-name">unregister-observer-with-class</span> (class
instance
slot-name
key))
-(<span style="color: #b9d3ee;">defmethod</span> <span style="color: #87cefa;">register-observer-with-class</span> ((class observable)
+(<span class="emacs-face-keyword">defmethod</span> <span class="emacs-face-function-name">register-observer-with-class</span> ((class observable)
instance
slot-name
key
(setf (gethash key
(or (gethash slot-name
(slot-value instance 'observers))
- <span style="color: #ff7f24;">;; </span><span style="color: #ff7f24;">Lazily add observer hash tables
+ <span class="emacs-face-comment-delimiter">;; </span><span class="emacs-face-comment">Lazily add observer hash tables
</span> (add-observer-table instance slot-name)))
closure))
-(<span style="color: #b9d3ee;">defmethod</span> <span style="color: #87cefa;">unregister-observer-with-class</span> ((class observable)
+(<span class="emacs-face-keyword">defmethod</span> <span class="emacs-face-function-name">unregister-observer-with-class</span> ((class observable)
instance
slot-name
key)
(remhash key (gethash slot-name
(slot-value instance 'observers))))
-(<span style="color: #b9d3ee;">defmethod</span> <span style="color: #87cefa;">get-observers-with-class</span> ((class observable)
+(<span class="emacs-face-keyword">defmethod</span> <span class="emacs-face-function-name">get-observers-with-class</span> ((class observable)
instance
slot-name)
(gethash slot-name (slot-value instance 'observers)))
-(<span style="color: #b9d3ee;">defmethod</span> (<span style="color: #87cefa;">setf slot-value-using-class)</span> <span style="color: #b0c4de;">:before</span> (new-value
+(<span class="emacs-face-keyword">defmethod</span> (<span class="emacs-face-function-name">setf slot-value-using-class</span>) <span class="emacs-face-builtin">:before</span> (new-value
(class observable)
instance
slot)
- (<span style="color: #b9d3ee;">let</span> ((slot-name (slot-definition-name slot)))
- (<span style="color: #b9d3ee;">if</span> (not (eq 'observers slot-name))
- (<span style="color: #b9d3ee;">let</span> ((observers
+ (<span class="emacs-face-keyword">let</span> ((slot-name (slot-definition-name slot)))
+ (<span class="emacs-face-keyword">if</span> (not (eq 'observers slot-name))
+ (<span class="emacs-face-keyword">let</span> ((observers
(get-observers instance (slot-definition-name slot))))
- (<span style="color: #b9d3ee;">if</span> observers
- (maphash #'(<span style="color: #b9d3ee;">lambda</span> (key observer)
+ (<span class="emacs-face-keyword">if</span> observers
+ (maphash #'(<span class="emacs-face-keyword">lambda</span> (key observer)
(funcall observer
- (<span style="color: #b9d3ee;">if</span> (slot-boundp instance slot-name)
+ (<span class="emacs-face-keyword">if</span> (slot-boundp instance slot-name)
(slot-value instance slot-name)
nil)
new-value))
<h3><a name="sec25" id="sec25"></a>
-Procedural Only Where Neccesary</h3>
+Procedural Only Where Necessary</h3>
-<p class="first">Some operations like method invocation are inheretly stateful and so
+<p class="first">Some operations like method invocation are inherently stateful and so
must use a procedural protocol. There is no benefit to be gained from
using a functional protocol, and indeed an attempt would result in
-obtuse code that severely restricted the implementian. Do note that
+obtuse code that severely restricted the implementation. Do note that
only a very small part of method invocation is stateful (the actual
call), and most of it can be implemented functionally (e.g. computing
the discriminating function).</p>
<h4><a name="sec27" id="sec27"></a>
<a href="http://common-lisp.net/project/ucw/">UCW</a> and <a href="http://common-lisp.net/project/bese/arnesi.html">Arnesi</a></h4>
-<p class="first">Arnesi uses the CLOS MOP to implement methods which are transparantly
+<p class="first">Arnesi uses the CLOS MOP to implement methods which are transparently
rewritten into continuation passing style. This allows their execution
to be suspended at certain points and resumed later. UCW builds on top
of this to support a web framework where the statelessness of http is
<h4><a name="sec29" id="sec29"></a>
<a href="http://common-lisp.net/project/elephant/">Elephant</a></h4>
-<p class="first">Elephant uses the CLOS MOP to transparantly store any class to disk
+<p class="first">Elephant uses the CLOS MOP to transparently store any class to disk
and handle paging between the disk store and memory efficiently
without user intervention.</p>
<h2><a name="sec30" id="sec30"></a>
-Sources &amp; Further Reading</h2>
+Sources and Further Reading</h2>
<h3><a name="sec31" id="sec31"></a>
Sources</h3>
+<h3><a name="sec39" id="sec39"></a>
+Software</h3>
+
+<h4><a name="sec40" id="sec40"></a>
+<a href="http://common-lisp.net/project/closer/closer-mop.html">Closer to MOP</a></h4>
+
+<p class="first">Compatibility layer that attempts to present the <em>Art of the Metaobject
+Protocol</em> MOP specification properly in as many Common Lisp
+implementation as possible.</p>
+
+
+
<!-- Page published by Emacs Muse ends here -->
</a>
</p>
-<p class="cke-footer">* jeffcovey becomes too groggy to read the directions and becomes
- the year's first nasal spray overdose fatality.
+<p class="cke-footer">No, there's nothing here about X, so be quiet.
</p>
<p class="cke-timestamp">Last Modified:
- September 26, 2008</p>
+ January 21, 2013</p>
</body>
</html>
\ No newline at end of file